home *** CD-ROM | disk | FTP | other *** search
/ PC-Blue - MS DOS Public Domain Library / PC-Blue MS-DOS Public Domain Library - NYACC.iso / vol059 / fishers.bas (.txt) < prev    next >
Encoding:
GW-BASIC  |  1987-01-13  |  1.8 KB  |  37 lines
  1. 1  '                FISHER'S EXACT TEST (one-tailed)
  2. 2  '               Copyright Tracy L. Gustafson, M.D.
  3. 3  '              Round Rock, Texas. Version 3.0, 1984
  4. 4  ON ERROR GOTO 5000:CHAIN MERGE "EPIMRG",5
  5. 22  DATA "FISHER'S EXACT TEST",27,21
  6. 30  P=0:PRINT:PRINT " Enter data in 2 by 2 table:"
  7. 35  LOCATE 9,22:PRINT "VARPTRSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDBSAVESOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDCOLOR"
  8. 40  FOR Z=1 TO 3:PRINT TAB(22);"CALL";TAB(38);"CALL";TAB(54);"CALL":NEXT
  9. 45  PRINT TAB(22);"BLOADSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDBEEPSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUND<0xB4!>"
  10. 50  FOR Z=1 TO 3:PRINT TAB(22);"CALL";TAB(38);"CALL";TAB(54);"CALL":NEXT
  11. 55  PRINT TAB(22);"CLSSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDMOTORSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUND'"
  12. 60  LOCATE 11,25:PRINT "A=  ":AR=11:AC=29:GOSUB 160:BA=I
  13. 65  LOCATE 11,42:PRINT "B=  ":AC=46:GOSUB 160:BB=I:PRINT
  14. 70  LOCATE 15,25:PRINT "C=  ":AR=15:AC=29:GOSUB 160:BC=I
  15. 75  LOCATE 15,42:PRINT "D=  ":AC=46:GOSUB 160:BD=I
  16. 80  LOCATE 19,27:COLOR 23:PRINT "CALCULATING PROBABILITY";
  17. 85  M=BA:IF BB<M THEN M=BB:SWAP BA,BB:SWAP BC,BD
  18. 90  IF BD<M THEN M=BD:SWAP BA,BD:SWAP BB,BC:GOTO 85
  19. 95  IF BC<M THEN M=BC:SWAP BA,BC:SWAP BB,BD
  20. 100  IF BA/BB>BC/BD THEN IF BC>BB THEN SWAP BA,BB:SWAP BC,BD ELSE SWAP BA,BC:SWAP BB,BD
  21. 105  PT=0:N=1
  22. 110  FOR Z=(BB+1) TO (BA+BB):PT=PT*Z/N:N=N+1:NEXT:N=BB+BD+1
  23. 115  FOR Z=(BC+1) TO (BA+BC):PT=PT*Z/N:N=N+1:NEXT:PT=PT*1E+30
  24. 120  FOR Z=(BD+1) TO (BC+BD):PT=PT*Z/N:N=N+1:NEXT:P=P+PT
  25. 125  IF BA>0 AND PT>0 THEN BA=BA-1:BB=BB+1:BC=BC+1:BD=BD-1:GOTO 105
  26. 130  PLAY "MS O3 L64 G O2 GE L9 E"
  27. 135  COLOR CLR2,CLR1:LOCATE 19,15:PRINT TAB(30);"p = ";:IF P<9E-09 THEN PRINT "< 10 (-8)"; ELSE PRINT P;
  28. 140  PRINT TAB(63):COLOR CLR1,CLR2:LOCATE 25,8
  29. 145  INPUT;"Do you want to perform another Fisher's exact test? (Y or N)   ",A$
  30. 150  IF A$="y" OR A$="Y" THEN CLS:GOTO 20
  31. 155  LOCATE 23,1:END
  32. 160  LOCATE AR,AC:INPUT;"",I:IF INT(I)<>I THEN BEEP:LOCATE 25,25:PRINT "Please enter INTEGERS only.";:LOCATE AR,AC:PRINT "      ":GOTO 160
  33. 165  RETURN
  34. 5000  BEEP:IF ERR<>53 AND ERR<>71 THEN 5010 ELSE LOCATE 10,10:PRINT "Please place EPISTAT in drive A: (or other default).":PRINT TAB(25);"Press any key to continue:"
  35. 5005  A$=INKEY$:IF A$="" THEN 5005 ELSE RESUME
  36. 5010  ON ERROR GOTO 0:END
  37.